perm filename MUSIO.FAI[MUS,SYS] blob sn#165232 filedate 1975-07-29 generic text, type T, neo UTF8
00100		TITLE MUSIO
00200		INTERNAL ZBIT,GETTAP,TOTAPE,FINTAP,BACKSP,USETI
00300		ENTRY	FILBRK,NOTDD
00400		;'CH' IS USED IN GETTAP, TOTAPE
00500		;'CH2' "  "    " MTA1, INMTA1, GETFI2, FASTI2
00600		INTERNAL GETFI2,FASTI2
00700	
00800		CH←12
00900		CH2←11
01000		CH3←13
01010	
01020	; CALL USETI(WDS/128)
01030	
01040	USETI:	0
01045		MOVE 1,@(16)
01050		USETI CH2,(1)
01060		JRA 1,1(16)
01100	
01200	;CALL TOTAPE(<ARRAY>,<NO.OF WORDS>)  WRITES ON MAGTAPE
01300	
01400	TOTAPE:	0
01500		HRRZ 0,0(16)
01600		SUBI 0,1
01700		MOVEM 0,COM
01800		MOVN 0,@1(16)
01900		HRLM 0,COM
02000		OUTPUT CH,COM
02100		STATZ CH,740000
02200		0
02300		JRA 16,2(16)
02400	
02500	;CALL GETTAP
02600	
02700	GETTAP:	0	;USES  TOTAPE, CH.  READS OR WRITES MTA0.
02800		INIT CH,617
02900		SIXBIT/MTA0/
03000		0
03100		HALT
03200		JRA 16,0(16)
03300	
03400	; CALL FINTAP
03500	
03600	FINTAP:	0
03700		CLOSE CH,0
03800		STATZ CH,740000
03900		0
04000		RELEASE CH,0
04100		JRA 16,0(16)
04200	; CALL BACKSP
04300	
04400	BACKSP:	0
04500		INIT CH,617
04600		SIXBIT/MTA0/
04700		0
04800		HALT
04900		MTAPE CH,7
05000		JRA 16,0(16)
05100	
05200	; CALL ZBIT(<INPUT ARRAY>,<OUTPUT ARRAY>)
05300	;              (256 WDS)     (512 WDS)
05400	
05500	ZBIT:	0
05600		MOVE 2,(16)
05700		MOVE 1,1(16)
05800		HRLI 2,-=256
05900	
06000	LOOP:	HLRE 0,(2)
06100		FSC 0,233	;FLOAT IT
06200		MOVEM 0,(1)	; GETS 512 18-BIT SAMPLES OUT OF 256 WDS.
06300		HRRE 0,(2)
06400		FSC 0,233
06500		MOVEM 0,1(1)
06600		ADDI 1,2
06700		AOBJN 2,LOOP
06800		JRA 16,1(16)
06900	
07000	
07100		BLKS←=1
07200	REGS:	BLOCK 20
07300	
07400	;CALL GETFIL(<FILE>)
07500	
07600	GETFI2:	0
07700		MOVE 0,@0(16)
07800		MOVEM 0,FILNAM
07900		JSA 16,INTFI2
08000		MOVE 0,[SIXBIT/DMD/]
08100		MOVEM 0,DIR+1
08200		JSA 16,LKUP
08300		SKIPA
08400		JRST GETF3
08500		SETZM DIR+1
08600		JSA 16,LKUP
08700		0
08800	GETF3:	JRA 16,1(16)
08900	
09000	LKUP:	0
09100		SETZM DIR+2
09200		SETZM DIR+3
09300		LOOKUP CH2,DIR
09400		JRA 16,0(16)
09500		JRA 16,1(16)
09600	
09700	DIR:	BLOCK 4
09800	
09900	;CALL FASTI2(<ARRAY>,<NO. WORDS>)
10000	
10100	FASTI2:	0
10200		HRRZ 0,0(16)
10300		SUBI 0,1
10400		MOVEM 0,COM
10500		MOVN 0,@1(16)
10600		HRLM 0,COM
10700		INPUT CH2,COM
10800		STATZ CH2,740000
10900		0
11000		JRA 16,2(16)
11100	
11200	INTFI2:	0	;INITS DSK 
11300		MOVEI REGS
11400		BLT REGS+3
11500		INIT CH2,17
11600		SIXBIT/DSK/
11700		0
11800		0
11900	DSKX:	MOVE 0,FILNAM#
12000		MOVEM 0,FN#
12100		MOVE 1,[POINT 7,FN]
12200	INTF3:	MOVE 2,[POINT 6,DIR]
12300		SETZM DIR
12400		MOVEI 3,5
12500	INTF1:	ILDB 0,1
12600		CAIN 0," "
12700		JRST INTF2
12800		SUBI 0,40
12900		IDPB 0,2
13000		SOJG 3,INTF1
13100	INTF2:	HRLZI REGS
13200		BLT 3
13300		JRA 16,0(16)
13400	
13500	COM:	OCT 0,0
13600	;;;COM1:	0
13700	BLKNUM:	0
13800	
14000	
14200		EXTERN	DEV
14300		INTERN	FNAM,DLK,ASTR
14400	
14500		WD←7
14600	
14700	ASTR:	ASCIZ/
14800	*/
14900	ZERSUB:	0
15000		MOVE	PT2
15100		MOVEM	PT
15200		SETZB	1,WD
15300		JRST	@ZERSUB
15400	
15500	COMSUB:	CAIN	15
15600		JRST	[MOVEI	10,EOJ
15700		JRST	(16)]
15800		CAIN	"["
15900		JRST	[MOVEI	10,GTPROJ
16000		JRST	(16)]
16100		CAIE	"."
16200		JRST	2(16)
16300		MOVEI	10,GTEXT
16400		JRST	(16)
16500	
16600	FSUB:	JSP	16,COMSUB
16700		MOVEM	WD,FNAM
16800		JRST	(10)
16900		CAIL	1,6
17000		JRST	.+3
17100		SUBI	40
17200		IDPB	PT
17300		AOJA	1,(15)
17400	
17500	ACS:	BLOCK	20
17600	
17700	FNAM:DLK:	0
17800	EXT:	0
17900		0
18000	PPN:	0
18100	PT:	POINT	6,WD
18200	PT2:	POINT	6,WD
18300	
18400	FILBRK:	0
18500		MOVEM	17,ACS+17
18600		MOVEI	17,ACS
18700		BLT	17,ACS+16
18800	ST:	MOVSI	'DSK'
18900		MOVEM	DEV
19000		SETZB	FNAM
19100		MOVEM	FNAM+1
19200		MOVEM	FNAM+2
19300		MOVEM	FNAM+3
19400		OUTSTR	ASTR
19500	GTDEV:	JSR	ZERSUB
19600		MOVEI	15,.+1
19700		INCHWL
19800		CAIE	":"
19900		JRST	FSUB
20000		MOVEM	WD,DEV
20100	GTFNAM:	JSR	ZERSUB
20200		MOVEI	15,.+1
20300		INCHWL
20400		JRST	FSUB
20500	GTEXT:	JSR	ZERSUB
20600		INCHWL
20700		JSP	16,COMSUB
20800		MOVEM	WD,EXT
20900		JRST	(10)
21000		CAIL	1,3
21100		JRST	.+3
21200		SUBI	40
21300		IDPB	PT
21400		AOJA	1,GTEXT+1
21500	
21600	GTPROJ:	SETZB	1,2
21700		INCHWL
21800		CAIN	","
21900		JRST	GTPROG
22000		SUBI	60
22100		CAILE	7
22200		JRST	ERR
22300		ASH	2,3
22400		JOV	ERR
22500		HRLZS
22600		ADD	2,
22700		JOV	ERR
22800		JRST	GTPROJ+1
22900	
23000	GTPROG:	INCHWL
23100		CAIE	15
23200		CAIN	"]"
23300		JRST	COMBIN
23400		SUBI	60
23500		CAILE	7
23600		JRST	ERR
23700		ASH	1,3
23800		JOV	ERR
23900		HRLZS
24000		ADD	1,
24100		JOV	ERR
24200		JRST	GTPROG
24300	COMBIN:	HLR	2,1
24400		MOVEM	2,PPN
24500	EOJ:	CLRBFI
24600		MOVSI	17,ACS
24700		BLT	17,16
24800		MOVE	17,ACS+17
24900		JRA	16,(16)
25000	ERR:	CLRBFI
25100		OUTSTR	[ASCIZ/?IMPROPER SYNTAX?
25200	/]
25300		JRST	ST
25400	
25500	;FUNCTION NOTDD(K)  --  IF NEG. IT'S NOT A DATADISC
25600	NOTDD:	0
25700		MOVNI	2,1
25800		GETLIN	2
25900		SETZ	;0=IT IS A DD
26000		TLNN	2,20000
26110		SETO	;-1=NOT DD
26200		JRA	16,1(16)
26300	
26400		END